package CastCopy;

use 5.008008;
use strict;
use warnings;
use vars qw($VERSION);
use POSIX qw(ceil floor);

use Config::Simple;
use Digest::MD5;
use File::Basename;
use IO::Socket::Multicast;

require Exporter;

our @ISA = qw(
    Exporter
    DynaLoader
);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration use CastCopy ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
  $VERSION
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
    send_file
    receive_file
    init
    uninit
    set_caller
    set_verbose
    set_data_port
    set_data_address
    set_control_port
    set_control_address
    set_blocksize
    verbose
    sysprint
    sysprint_ok
    sysprint_end
);

our $VERSION = '0.1';
our $opt_verbose = 0;
our $caller;
our $data_address;
our $data_port;
our $control_address;
our $control_port;
our $blocksize;

my $init = 1;
my $control_socket;
my $data_socket;
my %config;
my $datadest;
my $controldest;

use constant CKSM => "CKSUM";
use constant CTS => "CTS";
use constant PKTS => "PKTS";
use constant BLCKS => "BLCKS";

use constant CKSM_BUFFER => 39;
use constant CTS_BUFFER => 259;
use constant PKTS_BUFFER => 256;
use constant BLCKS_BUFFER => 11;

sub new {
  my $package = shift;
  return bless({}, $package);
}

sub check_config {
    my $death = 0;
    if ($data_address eq "") {
        $death = 1;
    } elsif ($data_port eq "") {
        $death = 1;
    } elsif ($control_address eq "") {
        $death = 1;
    } elsif ($control_port eq "") {
        $death = 1;
    } elsif ($blocksize eq "") {
        $death = 1;
    }
    if ($death) {
        die "\nIncomplete configuration.  You must call the following to appropriate values:\n" .
            "\tset_data_address()\n" .
            "\tset_data_port()\n" .
            "\tset_control_address()\n" .
            "\tset_control_port()\n" .
            "\tset_blocksize()\n\n";
    }
}

sub init {
    if ($init) {
        my $cfg = Config::Simple->import_from($_[0], %config) or die "Invalid configuration ($_[0]): $!\n";
        $data_address = $cfg->param("net.data_address");
        $data_port = $cfg->param("net.data_port");
        $control_address = $cfg->param("net.control_address");
        $control_port = $cfg->param("net.control_port");
        $blocksize = $cfg->param("options.blocksize");
        $datadest = "$data_address:$data_port";
        $controldest = "$control_address:$control_port";
        &check_config;
        $control_socket = IO::Socket::Multicast->new(LocalPort=>$control_port, ReuseAddr=>1) or die "Could not create socket: $!\n";
        $data_socket = IO::Socket::Multicast->new(LocalPort=>$data_port, ReuseAddr=>1) or die "Could not create socket: $!\n";
        $init = 0;
    }
}

sub uninit {
    if ($init == 0) {
        $control_socket->close;
        $data_socket->close;
    }
}

sub set_caller {
  $caller = $_[0] or die "CastCopy::set_caller -> need a valid calling program, got: $_[0]\n";
}

sub set_data_address {
    $data_address = $_[0] or die "CastCopy::set_data_address -> need a valid data address, got: @_\n";
}

sub set_data_port {
    $data_port = $_[0] or die "CastCopy::set_data_port -> need a valid data port, got: @_\n";
}

sub set_control_address {
    $control_address = $_[0] or die "CastCopy::set_control_address -> need a valid control address, got: @_\n";
}

sub set_control_port {
    $control_port = $_[0] or die "CastCopy::set_control_port -> need a valid control port, got: @_\n";
}

sub set_blocksize {
    $blocksize = $_[0] or die "CastCopy::set_blocksize -> need a valid blocksize, got: @_\n";
}

sub set_verbose {
  if ($_[0] == 1) {
    $opt_verbose = 1;
  } else {
    $opt_verbose = 0;
  }
}

sub verbose {
  if ($opt_verbose) {
    if ($caller ne "" || die "Did you forget to use set_caller?") {
      print "$caller: $_[0]\n";
    }
  }
}

sub sysprint {
    if ($opt_verbose) {
        system("echo -en \"[$_[0]... \"");
    }
}

sub sysprint_end {
    if ($opt_verbose) {
        system("echo \"$_[0]]\"");
    }
}

sub sysprint_ok {
    if ($opt_verbose) {
        system("echo \"ok.]\"");
    }
}

sub checksum_file {
    my $FILE;
    my $CKSUM;
    open(FILE, $_[0]) or die "Could not open $_[0]: $!\n";
    binmode(FILE);
    $CKSUM = Digest::MD5->new->addfile(*FILE)->hexdigest;
    CORE::close(FILE);
    return $CKSUM;
}

sub size_file {
    return -s $_[0];
}

sub send_checksum {
    $control_socket->mcast_send(CKSM . " @_", $controldest) or die "Could not send CKSUM: $!\n";
}

sub send_cts {
    $control_socket->mcast_send(CTS . " " . basename(@_), $controldest) or die "Could not send CTS: $!\n";
}

sub send_packet_count {
    $control_socket->mcast_send(PKTS . " @_", $controldest) or die "Could not send PKTS: $!\n";
}

sub send_block_info {
    $control_socket->mcast_send(BLCKS . " @_", $controldest) or die "Could not send CHNK: $!\n";
}

# provide overwrite on MD5 only, local file, remote file, etc.
sub receive_file {

    $control_socket->mcast_add($control_address) or die "Could not set control group: $!\n";
    $data_socket->mcast_add($data_address) or die "Could not set data group: $!\n";

    sysprint("File to receive");
    my $remote_file = $_[0];
    sysprint_end($remote_file);

    sysprint("MD5 mismatch downloads");
    my $md5_mismatch = 0;
    if ($_[1]) {
        sysprint_end("yes");
        $md5_mismatch = 1;
    } else {
        sysprint_end("no");
    }

    my $local_file;
    sysprint("Remote filename overrides");
    if ($_[2]) {
        $local_file = $_[2];
        sysprint_end("yes, $local_file");
    } else {
        sysprint_end("no");
        $local_file = $remote_file;
    }

    my $local_cksum;
    if ($md5_mismatch) {
        sysprint("Computing checksum");
        if ($local_file and -e $local_file) {
            $local_cksum = checksum_file($local_file);
        } elsif (-e $remote_file) {
            $local_cksum = checksum_file($remote_file);
        }
        if ($local_cksum) {
            sysprint_end($local_cksum);
        } else {
            sysprint_end("n/a");
        }
        if (!$local_cksum) {
            $md5_mismatch = 0;
        }
    }

    my $data_buf;
    my @tokens;

    sysprint("Waiting to receive checksum");
    $control_socket->recv($data_buf, CKSM_BUFFER) or die "Could not receive checksum: $!\n";
    @tokens = split / /, $data_buf;
    if ($tokens[0] ne CKSM) {
        die "Received invalid command (expected CKSM): $data_buf\n";
    }
    my $remote_cksum = $tokens[1];
    sysprint_end($remote_cksum);

    sysprint("Waiting to receive packet info");
    $control_socket->recv($data_buf, PKTS_BUFFER) or die "Could not receive packet info: $!\n";
    @tokens = split / /, $data_buf;
    if ($tokens[0] ne PKTS) {
        die "Received invalid command (expected PKTS): $data_buf\n";
    }
    my $remote_pkt = $tokens[1];
    sysprint_end($remote_pkt);

    sysprint("Waiting to receive block info");
    $control_socket->recv($data_buf, BLCKS_BUFFER) or die "Could not receive block info: $!\n";
    @tokens = split / /, $data_buf;
    if ($tokens[0] ne BLCKS) {
        die "Received invalid command (expected BLCKS): $data_buf\n";
    }
    my $remote_blck = $tokens[1];
    sysprint_end($remote_blck);

    sysprint("Waiting to receive CTS signal");
    $control_socket->recv($data_buf, CTS_BUFFER) or die "Could not receive CTS signal: $!\n";
    @tokens = split / /, $data_buf;
    if ($tokens[0] ne CTS) {
        die "Received invalid command (expected CTS): $data_buf\n";
    }
    my $remote_file2 = $data_buf;
    $remote_file2 =~ s/CTS //g;
    sysprint_end($remote_file2);

    if ($remote_file2 ne $remote_file) {
        verbose("skipping file");
        return 0;
    }

    if ($md5_mismatch) {
        if ($remote_cksum eq $local_cksum) {
            verbose("MD5 match, we're good");
            return 1;
        }
    } 

    my $i = 1;
    my $data;
    open(FILE, ">$local_file") or die "Could not open $local_file for writing: $!\n";
    binmode(FILE);
    sysprint("Waiting for transfer to start");
    while ($i <= $remote_pkt) {
        $data_socket->recv($data, $remote_blck);
        syswrite(FILE, $data);
        $i++;
    }
    sysprint_ok;
    
    sysprint("Computing checksum of received file");
    my $new_cksum = checksum_file($local_file);
    sysprint_end($new_cksum);
    if ($new_cksum eq $remote_cksum) {
        return 1;
    } else {
        return 0;
    }
}

sub send_file {
    sysprint("Computing checksum");
    my $cksum = checksum_file($_[0]);
    sysprint_end($cksum);

    sysprint("Determining filesize");
    my $fsize = size_file($_[0]);
    sysprint_end($fsize);

    sysprint("Computing packets");
    my $packets = ceil($fsize / $blocksize);
    sysprint_end($packets);

    sysprint("Sending checksum");
    send_checksum($cksum);
    sysprint_ok;

    sysprint("Sending packet count");
    send_packet_count($packets);
    sysprint_ok;

    sysprint("Sending block size");
    send_block_info($blocksize);
    sysprint_ok;

    sysprint("Sending CTS signal");
    send_cts($_[0]);
    sysprint_ok;

    my $len;
    my $buf;
    open(FILE, $_[0]) or die "Could not open file $_[0]: $!\n";
    binmode(FILE);
    sleep 1;
    sysprint("Writing $packets packets");
    my $count = 1;
    while (($len = sysread(FILE, $buf, $blocksize))) {
        $data_socket->mcast_send($buf, $datadest) or die "Could not send packet $count: $!\n";
        $count++;
    }
    CORE::close(FILE);
    sysprint_ok;
}

# Preloaded methods go here.

1;
__END__
# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

CastCopy - Perl extension for cast and get-cast

=head1 SYNOPSIS

  use CastCopy;
  my $cfgfile = '/etc/castcopy.cfg';
  set_caller($0);
  init($cfgfile);
  send_file(<filename>);

=head1 DESCRIPTION

CastCopy provides multicast file transfer mechanisms using the configuration
file specified using init().  See cast, get-cast, and the listener programs
that come with CastCopy for examples.

=head2 EXPORT

    send_file
    receive_file
    init
    uninit
    set_caller
    set_verbose
    set_data_port
    set_data_address
    set_control_port
    set_control_address
    set_blocksize
    verbose
    sysprint
    sysprint_ok
    sysprint_end

=head1 SEE ALSO

cast, get-cast, listener

http://www.den-4.com/node/67

=head1 AUTHOR

Nick Bargnesi, nick@den-4.com

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007 by Nick Bargnesi

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.

=cut
